home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH1 / SRC / RUBBER.FRM < prev    next >
Text File  |  1995-12-15  |  3KB  |  100 lines
  1. VERSION 4.00
  2. Begin VB.Form RubberForm 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Rubberband Lines"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   1140
  7.    ClientTop       =   1800
  8.    ClientWidth     =   6690
  9.    Height          =   4830
  10.    Left            =   1080
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4140
  13.    ScaleWidth      =   6690
  14.    Top             =   1170
  15.    Width           =   6810
  16.    Begin VB.Menu mnuFile 
  17.       Caption         =   "&File"
  18.       Begin VB.Menu mnuFileExit 
  19.          Caption         =   "E&xit"
  20.       End
  21.    End
  22. End
  23. Attribute VB_Name = "RubberForm"
  24. Attribute VB_Creatable = False
  25. Attribute VB_Exposed = False
  26. Option Explicit
  27.  
  28. Dim Rubberbanding As Boolean
  29. Dim OldMode As Integer
  30. Dim FirstX As Single
  31. Dim FirstY As Single
  32. Dim LastX As Single
  33. Dim LastY As Single
  34.  
  35. ' ***********************************************
  36. ' Start rubberbanding.
  37. ' ***********************************************
  38. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  39.     ' Let MouseMove know we are rubberbanding.
  40.     Rubberbanding = True
  41.     
  42.     ' Save DrawMode so we can restore it later.
  43.     OldMode = DrawMode
  44.     DrawMode = vbInvert
  45.  
  46.     ' Save the starting coordinates.
  47.     FirstX = X
  48.     FirstY = Y
  49.     
  50.     ' Draw the initial rubberband line.
  51.     LastX = X
  52.     LastY = Y
  53.     Line (FirstX, FirstY)-(LastX, LastY)
  54. End Sub
  55.  
  56.  
  57. ' ***********************************************
  58. ' Continue rubberbanding.
  59. ' ***********************************************
  60. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  61.     ' If we are not rubberbanding, do nothing.
  62.     If Not Rubberbanding Then Exit Sub
  63.     
  64.     ' Erase the previous rubberband line.
  65.     Line (FirstX, FirstY)-(LastX, LastY)
  66.  
  67.     ' Draw the new rubberband line.
  68.     LastX = X
  69.     LastY = Y
  70.     Line (FirstX, FirstY)-(LastX, LastY)
  71. End Sub
  72.  
  73.  
  74. ' ***********************************************
  75. ' Stop rubberbanding.
  76. ' ***********************************************
  77. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  78.     ' If we are not rubberbanding, do nothing.
  79.     If Not Rubberbanding Then Exit Sub
  80.     
  81.     ' We are no longer rubberbanding.
  82.     Rubberbanding = False
  83.     
  84.     ' Erase the previous rubberband line.
  85.     Line (FirstX, FirstY)-(LastX, LastY)
  86.     
  87.     ' Restore the original DrawMode.
  88.     DrawMode = OldMode
  89.  
  90.     ' Make the final line permanent.
  91.     Line (FirstX, FirstY)-(LastX, LastY)
  92. End Sub
  93.  
  94.  
  95. Private Sub mnuFileExit_Click()
  96.     Unload Me
  97. End Sub
  98.  
  99.  
  100.